This section illustrates how to access data, and defines helper methods to filter, map, summarise, and plot data.
Once refined, these helper functions will become core wastdr functionality.
commments for QA messages.if (file.exists("~/tracks.Rda")){
load("~/tracks.Rda")
} else {
track_records <- wastdr::get_wastd("turtle-nest-encounters")
save(track_records, file = "~/track_records.Rda")
load("~/track_records.Rda")
# listviewer::jsonedit(utils::head(track_records$features))
tracks <- parse_turtle_nest_encounters(track_records)
save(tracks, file = "~/tracks.Rda")
}To filter records to one area, we can either filter by area or site ID (once enabled), or simply filter by a bounding box. Additionaly, we’ll filter by date.
In this example, we’ll filter to an area surveyed by the West Pilbara Turtle Program.
species_colours <- tibble::tibble(
species = c(
"cheloniidae-fam",
"chelonia-mydas",
"eretmochelys-imbricata",
"natator-depressus",
"corolla-corolla",
"lepidochelys-olivacea",
"caretta-caretta"
),
species_colours = c(
"gray",
"green",
"darkblue",
"beige",
"pink",
"darkgreen",
"orange"
)
)
nest_type_text <- tibble::tibble(
nest_type = c(
"hatched-nest",
"successful-crawl",
"track-not-assessed",
"track-unsure",
"nest",
"false-crawl"),
nest_type_text = c(
"NH",
"N",
"T+?",
"N?",
"N",
"T")
)
add_lookups <- . %>%
left_join(species_colours, by="species") %>%
left_join(nest_type_text, by="nest_type")
filter_2017 <- . %>% dplyr::filter(date > dmy("17/11/2017")) %>% add_lookups
filter_broome <- . %>% dplyr::filter(area_name=="Cable Beach Broome")
filter_eighty_mile_beach <- . %>% dplyr::filter(area_name=="Eighty Mile Beach Caravan Park")
filter_anna_plains <- . %>% dplyr::filter(area_name=="Anna Plains")
filter_port_hedland <- . %>% dplyr::filter(site_name=="Port Hedland Turtle Nesting Beaches")
filter_west_pilbara <- . %>% dplyr::filter(area_name=="Karratha / Burrup")
filter_thevenard <- . %>% dplyr::filter(area_name=="Thevenard Island")tracks_map <- function(track_data) {
l <- leaflet(width=800, height=600) %>%
addProviderTiles("Esri.WorldImagery", group = "Aerial") %>%
addProviderTiles("OpenStreetMap.Mapnik", group = "Place names") %>%
clearBounds()
tracks.df <- track_data %>% split(track_data$species)
names(tracks.df) %>%
purrr::walk( function(df) {
l <<- l %>%
addAwesomeMarkers(
data = tracks.df[[df]],
lng = ~longitude, lat=~latitude,
icon = leaflet::makeAwesomeIcon(
text = ~nest_type_text,
markerColor = ~species_colours),
label=~paste(date, nest_age, species, nest_type, name),
popup=~paste(date, nest_age, species, nest_type, name),
group = df
)
})
l %>%
addLayersControl(
baseGroups = c("Aerial", "Place names"),
overlayGroups = names(tracks.df),
options = layersControlOptions(collapsed = FALSE)
)
}Data (all tracks or filtered subsets) are filtered to only fresh observations, then grouped and tallied by date, species and type.
Daily summaries are shown in wide form as tables, and (using long form) as timeseries plots.
daily_species_by_type <- . %>%
filter(nest_age=="fresh") %>%
group_by(date, species, nest_type) %>%
tally() %>%
ungroup()
daily_summary <- . %>%
daily_species_by_type %>%
tidyr::spread(nest_type, n, fill=0) %>%
DT::datatable(.)
tracks_ts <- . %>%
daily_species_by_type %>%
{ggplot2::ggplot(data=., aes(x = date, y = n, colour = nest_type)) +
ggplot2::geom_point() +
ggplot2::geom_smooth(method = "auto") +
# ggplot2::geom_line() +
ggplot2::scale_x_date(breaks = scales::pretty_breaks(),
labels = scales::date_format("%d %b %Y")) +
ggplot2::xlab("Date") +
ggplot2::ylab("Number counted per day") +
ggplot2::ggtitle("Nesting activity") +
ggplot2::theme_light()}This chapter uses the data and helpers from the above section and provides some insight into the different regions.
This section is by no means complete and can be extended as appropriate.
tracks_cbb <- tracks %>% filter_2017 %>% filter_broome
tracks_cbb %>% tracks_maptracks_cbb %>% DT::datatable(.)tracks_cbb %>% daily_summarytracks_cbb %>% tracks_ts
#> `geom_smooth()` using method = 'loess'
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : span too small. fewer data values than degrees of freedom.
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : pseudoinverse used at 17496
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : neighborhood radius 20.21
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : reciprocal condition number 0
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : There are other near singularities as well. 493.28
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : span too small.
#> fewer data values than degrees of freedom.
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : pseudoinverse used
#> at 17496
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : neighborhood radius
#> 20.21
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : reciprocal
#> condition number 0
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : There are other
#> near singularities as well. 493.28
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : span too small. fewer data values than degrees of freedom.
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : pseudoinverse used at 17498
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : neighborhood radius 11.16
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : reciprocal condition number 0
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : There are other near singularities as well. 447.75
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : span too small.
#> fewer data values than degrees of freedom.
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : pseudoinverse used
#> at 17498
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : neighborhood radius
#> 11.16
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : reciprocal
#> condition number 0
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : There are other
#> near singularities as well. 447.75
named_nests_cbb <- tracks_cbb %>% filter(!(is.na(name)))
named_nests_cbb %>% tracks_mapnamed_nests_cbb %>% DT::datatable(.)tracks_ap <- tracks %>% filter_2017 %>% filter_anna_plains
tracks_ap %>% tracks_maptracks_ap %>% DT::datatable(.)tracks_ap %>% daily_summarytracks_ap %>% tracks_ts
#> `geom_smooth()` using method = 'loess'
tracks_emb <- tracks %>% filter_2017 %>% filter_eighty_mile_beach
tracks_emb %>% tracks_maptracks_emb %>% DT::datatable(.)tracks_emb %>% daily_summarytracks_emb %>% tracks_ts
#> `geom_smooth()` using method = 'loess'
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : pseudoinverse used at 17496
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : neighborhood radius 7.05
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : reciprocal condition number 2.3619e-17
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : There are other near singularities as well. 49.702
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : pseudoinverse used
#> at 17496
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : neighborhood radius
#> 7.05
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : reciprocal
#> condition number 2.3619e-17
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : There are other
#> near singularities as well. 49.702
tracks_pth <- tracks %>% filter_2017 %>% filter_port_hedland
tracks_pth %>% tracks_maptracks_pth %>% DT::datatable(.)tracks_pth %>% daily_summarytracks_pth %>% tracks_ts
#> `geom_smooth()` using method = 'loess'
# named_nests_pth <- tracks_pth %>% filter(!(is.na(name)))
# named_nests_pth %>% tracks_map
# named_nests_pth %>% DT::datatable(.)tracks_wp <- tracks %>% filter_2017 %>% filter_west_pilbara
tracks_wp %>% tracks_maptracks_wp %>% DT::datatable(.)tracks_wp %>% daily_summarytracks_wp %>% tracks_ts
#> `geom_smooth()` using method = 'loess'
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : span too small. fewer data values than degrees of freedom.
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : pseudoinverse used at 17494
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : neighborhood radius 15.085
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : reciprocal condition number 0
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : There are other near singularities as well. 4.3472
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : span too small.
#> fewer data values than degrees of freedom.
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : pseudoinverse used
#> at 17494
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : neighborhood radius
#> 15.085
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : reciprocal
#> condition number 0
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : There are other
#> near singularities as well. 4.3472
tracks_thv <- tracks %>% filter_2017 %>% filter_thevenard
tracks_thv %>% tracks_maptracks_thv %>% DT::datatable(.)
#> Warning in instance$preRenderHook(instance): It seems your data is too
#> big for client-side DataTables. You may consider server-side processing:
#> http://rstudio.github.io/DT/server.htmltracks_thv %>% daily_summarytracks_thv %>% tracks_ts
#> `geom_smooth()` using method = 'loess'
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : span too small. fewer data values than degrees of freedom.
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : pseudoinverse used at 17499
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : neighborhood radius 2.045
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : reciprocal condition number 0
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : There are other near singularities as well. 49.632
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : span too small.
#> fewer data values than degrees of freedom.
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : pseudoinverse used
#> at 17499
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : neighborhood radius
#> 2.045
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : reciprocal
#> condition number 0
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : There are other
#> near singularities as well. 49.632
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : span too small. fewer data values than degrees of freedom.
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : at 17506
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : radius 2.5e-05
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : all data on boundary of neighborhood. make span bigger
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : pseudoinverse used at 17506
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : neighborhood radius 0.005
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : reciprocal condition number 1
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : at 17507
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : radius 2.5e-05
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : all data on boundary of neighborhood. make span bigger
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : There are other near singularities as well. 2.5e-05
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : zero-width neighborhood. make span bigger
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : zero-width neighborhood. make span bigger
#> Warning: Computation failed in `stat_smooth()`:
#> NA/NaN/Inf in foreign function call (arg 5)